{ ******************************************************* }
{ }
{ registry and ini file access library }
{ }
{ Thoudred Software  2008 }
{ }
{ Copyright reserved }
{ }
{ ******************************************************* }

unit RegIniUtils;

interface

uses
  Windows, Classes, SysUtils;

function IniReadInteger(FileName, AppName, KeyName: string;
  Default: Integer): Integer;
function IniReadString(FileName, AppName, KeyName, Default: string): string;
function IniReadBool(FileName, AppName, KeyName: string;
  Default: Boolean): Boolean;
procedure IniReadSections(const FileName: string; Strings: TStrings);
procedure IniReadSection(const FileName, Section: string; Strings: TStrings);
function IniWriteInteger(FileName, AppName, KeyName: string;
  Value: Integer): Boolean;
function IniWriteString(FileName, AppName, KeyName, Value: string): Boolean;
function IniWriteBool(FileName, AppName, KeyName: string;
  Value: Boolean): Boolean;
function IniSectionExists(FileName, SectionName: string): Boolean;
function IniValueExists(FileName, SectionName, KeyName: string): Boolean;

function RegGetValueType(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): DWORD;
function RegGetKey(RootKey: HKEY; KeyName: string; var phkResult: HKEY;
  Create: Boolean = False): Boolean;
function RegReadBuffer(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Pointer;
function RegReadInteger(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Integer;
function RegReadString(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): string;
function RegReadBool(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
procedure RegReadMultiStr(KeyName, Name: string; pResult: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE);
function RegWriteInteger(KeyName, Name: string; Value: Integer;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
function RegWriteStr(KeyName, Name, Value: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
function RegWriteBool(KeyName, Name: string; Value: Boolean;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
function RegWriteMultiStr(KeyName, Name: string; Value: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE; CreateOnNotExists: Boolean = False)
  : Boolean; overload;
function RegWriteMultiStr(KeyName, Name: string; Value: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE; CreateOnNotExists: Boolean = False)
  : Boolean; overload;
function RegGetSubKeys(KeyName: string; Strings: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
function RegGetValueNames(KeyName: string; Strings: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;

implementation

function StringListToDilimiteredString(StrList: TStrings;
  Delimiter, Terminate: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to StrList.Count - 1 do
  begin
    Result := Result + StrList[i];
    if i < StrList.Count - 1 then
      Result := Result + Delimiter;
  end;
  Result := Result + Terminate;
end;

procedure DelimiteredStringToStringList(Buffer: PChar; pResult: TStrings);
begin
  pResult.Clear;
  while lStrLen(Buffer) > 0 do
  begin
    pResult.Add(Buffer);
    Inc(Buffer, lStrLen(Buffer) + 1);
  end;
end;

function IniReadInteger(FileName, AppName, KeyName: string;
  Default: Integer): Integer;
begin
  Result := GetPrivateProfileInt(PChar(AppName), PChar(KeyName), Default,
    PChar(FileName));

end;

function IniReadString(FileName, AppName, KeyName, Default: string): string;
var
  Buffer: array [0 .. 2047] of Char;
begin
  SetString(Result, Buffer, GetPrivateProfileString(PChar(AppName),
    PChar(KeyName), PChar(Default), Buffer, SizeOf(Buffer), PChar(FileName)));
end;

function IniReadBool(FileName, AppName, KeyName: string;
  Default: Boolean): Boolean;
begin
  Result := GetPrivateProfileInt(PChar(AppName), PChar(KeyName), Ord(Default),
    PChar(FileName)) <> 0;
end;

procedure IniReadSections(const FileName: string; Strings: TStrings);
const
  BufSize = 16384;
var
  Buffer, P: PChar;
begin
  GetMem(Buffer, BufSize);
  try
    Strings.BeginUpdate;
    try
      Strings.Clear;
      if GetPrivateProfileString(nil, nil, nil, Buffer, BufSize, PChar(FileName)
        ) <> 0 then
      begin
        P := Buffer;
        while P^ <> #0 do
        begin
          Strings.Add(P);
          Inc(P, StrLen(P) + 1);
        end;
      end;
    finally
      Strings.EndUpdate;
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

procedure IniReadSection(const FileName, Section: string; Strings: TStrings);
const
  BufSize = 16384;
var
  Buffer, P: PChar;
begin
  GetMem(Buffer, BufSize);
  try
    Strings.BeginUpdate;
    try
      Strings.Clear;
      if GetPrivateProfileString(PChar(Section), nil, nil, Buffer, BufSize,
        PChar(FileName)) <> 0 then
      begin
        P := Buffer;
        while P^ <> #0 do
        begin
          Strings.Add(P);
          Inc(P, StrLen(P) + 1);
        end;
      end;
    finally
      Strings.EndUpdate;
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

procedure IniReadSectionValues(const FileName, Section: string;
  Strings: TStrings);
var
  KeyList: TStringList;
  i: Integer;
begin
  KeyList := TStringList.Create;
  try
    IniReadSection(FileName, Section, KeyList);
    Strings.BeginUpdate;
    try
      Strings.Clear;
      for i := 0 to KeyList.Count - 1 do
        Strings.Add(KeyList[i] + '=' + IniReadString(FileName, Section,
          KeyList[i], ''))
    finally
      Strings.EndUpdate;
    end;
  finally
    KeyList.Free;
  end;
end;

function IniWriteInteger(FileName, AppName, KeyName: string;
  Value: Integer): Boolean;
begin
  Result := WritePrivateProfileString(PChar(AppName), PChar(KeyName),
    PChar(IntToStr(Value)), PChar(FileName));
end;

function IniWriteString(FileName, AppName, KeyName, Value: string): Boolean;
begin
  Result := WritePrivateProfileString(PChar(AppName), PChar(KeyName),
    PChar(Value), PChar(FileName));
end;

function IniWriteBool(FileName, AppName, KeyName: string;
  Value: Boolean): Boolean;
begin
  Result := WritePrivateProfileString(PChar(AppName), PChar(KeyName),
    PChar(IntToStr(Ord(Value))), PChar(FileName));
end;

function RegReadString(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): string;
var
  P: Pointer;
begin
  P := RegReadBuffer(KeyName, Name, RootKey);
  if P = nil then
    Result := ''
  else
  begin
    Result := PAnsiChar(P);
{$IF CompilerVersion>23.0} {$ELSE}StrDispose(P); {$IFEND}
  end;
end;

function IniSectionExists(FileName, SectionName: string): Boolean;
var
  lstSection: TStrings;
begin
  lstSection := TStringList.Create;
  try
    IniReadSections(FileName, lstSection);
    Result := lstSection.IndexOf(SectionName) <> -1;
  finally
    lstSection.Free;
  end;
end;

function IniValueExists(FileName, SectionName, KeyName: string): Boolean;
var
  lstKey: TStrings;
begin
  lstKey := TStringList.Create;
  try
    IniReadSection(FileName, SectionName, lstKey);
    Result := lstKey.IndexOf(KeyName) <> -1;
  finally
    lstKey.Free;
  end;
end;

function RegReadBuffer(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Pointer;
var
  Buffer: Pointer;
  hReg: HKEY;
  cbType, cbResult: DWORD;
begin
  cbType := REG_NONE;
  try
    if (RegOpenKeyEx(RootKey, PChar(KeyName), 0, KEY_QUERY_VALUE, hReg)
      = ERROR_SUCCESS) and (RegQueryValueEx(hReg, PChar(Name), nil, @cbType,
      nil, @cbResult) = ERROR_SUCCESS) and
      (cbType in [REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ, REG_BINARY]) then
    begin
      Buffer := Pointer(StrAlloc(cbResult));
      if RegQueryValueEx(hReg, PChar(Name), nil, @cbType, Buffer, @cbResult) = ERROR_SUCCESS
      then
        Result := Pointer(Buffer)
      else
        Result := nil;
    end
    else
      Result := nil;
  finally
    RegCloseKey(hReg);
  end;
end;

procedure RegReadMultiStr(KeyName, Name: string; pResult: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE);
var
  P: Pointer;
begin
  P := RegReadBuffer(KeyName, Name, RootKey);
  if P = nil then
    pResult.Clear
  else
  begin
    DelimiteredStringToStringList(PChar(P), pResult);
    // {$IFDEF VER230}{$ELSE}StrDispose(p){$ENDIF};
{$IF CompilerVersion>23.0} {$ELSE}StrDispose(P); {$IFEND}
  end;
end;

function RegGetKey(RootKey: HKEY; KeyName: string; var phkResult: HKEY;
  Create: Boolean = False): Boolean;
var
  Disposition: Integer;
begin
  if Create then
    RegCreateKeyEx(RootKey, PChar(KeyName), 0, nil, REG_OPTION_NON_VOLATILE,
      KEY_READ or KEY_WRITE, nil, phkResult, @Disposition)
  else
    RegOpenKeyEx(RootKey, PChar(KeyName), 0, KEY_READ or KEY_WRITE, phkResult);
  Result := phkResult <> 0;
end;

function RegGetValueType(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): DWORD;
var
  hReg: HKEY;
begin
  try
    if (RegOpenKeyEx(RootKey, PChar(KeyName), 0,
      KEY_QUERY_VALUE, hReg) <> ERROR_SUCCESS) or
      (RegQueryValueEx(hReg, PChar(Name), nil, @Result, nil, nil) <>
      ERROR_SUCCESS) then
      Result := REG_NONE;
  finally
    RegCloseKey(hReg);
  end;
end;

function RegReadInteger(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Integer;
var
  hReg: HKEY;
  cbType, cbResult: DWORD;
begin
  try
    cbType := REG_NONE;
    if (RegOpenKeyEx(RootKey, PChar(KeyName), 0,
      KEY_QUERY_VALUE, hReg) <> ERROR_SUCCESS) or
      (RegQueryValueEx(hReg, PChar(Name), nil, @cbType, @Result, @cbResult) <>
      ERROR_SUCCESS) or (cbType <> REG_DWORD) then
      Result := 0;
  finally
    RegCloseKey(hReg);
  end;
end;

function RegReadBool(KeyName, Name: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
var
  hReg: HKEY;
  cbType, cbResult, dwResult: DWORD;
begin
  try
    cbType := REG_NONE;
    if (RegOpenKeyEx(RootKey, PChar(KeyName), 0,
      KEY_QUERY_VALUE, hReg) <> ERROR_SUCCESS) or
      (RegQueryValueEx(hReg, PChar(Name), nil, @cbType, @dwResult, @cbResult) <>
      ERROR_SUCCESS) or (cbType <> REG_DWORD) then
      Result := False
    else
      Result := dwResult <> 0;
    if hReg > 0 then
      RegCloseKey(hReg);
  finally
    RegCloseKey(hReg);
  end;
end;

function RegWriteInteger(KeyName, Name: string; Value: Integer;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
var
  hReg: HKEY;
begin
  Result := True;
  try
    if not RegGetKey(RootKey, KeyName, hReg, CreateOnNotExists) or
      (RegSetValueEx(hReg, PChar(Name), 0,
      REG_DWORD, @Value, SizeOf(DWORD)) <> ERROR_SUCCESS) then
      Result := False;
  finally
    RegCloseKey(hReg);
  end;
end;

function RegWriteStr(KeyName, Name, Value: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
var
  hReg: HKEY;
begin
  Result := True;
  try
    if not RegGetKey(RootKey, KeyName, hReg, CreateOnNotExists) or
      (RegSetValueEx(hReg, PChar(Name), 0, REG_SZ,
      PAnsiChar(Value), Length(Value) + 1) <> ERROR_SUCCESS) then
      Result := False;
  finally
    RegCloseKey(hReg);
  end;
end;

function RegWriteBool(KeyName, Name: string; Value: Boolean;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
begin
  Result := RegWriteInteger(KeyName, Name, Ord(Value), RootKey, True);
end;

function RegWriteMultiStr(KeyName, Name: string; Value: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
begin
  Result := RegWriteMultiStr(KeyName, Name, StringListToDilimiteredString(Value,
    #0, #0#0), RootKey, CreateOnNotExists);
end;

function RegWriteMultiStr(KeyName, Name, Value: string;
  RootKey: HKEY = HKEY_LOCAL_MACHINE;
  CreateOnNotExists: Boolean = False): Boolean;
var
  hReg: HKEY;
begin
  Result := True;
  try
    if not RegGetKey(RootKey, KeyName, hReg, CreateOnNotExists) or
      (RegSetValueEx(hReg, PChar(Name), 0,
      REG_MULTI_SZ, PAnsiChar(Value), Length(Value)) <> ERROR_SUCCESS) then
      Result := False;
  finally
    RegCloseKey(hReg);
  end;
end;

function RegGetSubKeys(KeyName: string; Strings: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
var
  SubKeyCnt: DWORD;
  MaxSubKeyLen, Len: DWORD;
  hK: HKEY;
  i: Integer;
  SubKeyName: string;
begin
  Result := False;
  hK := 0;
  try
    if not RegGetKey(RootKey, KeyName, hK) or
      not(RegQueryInfoKey(hK, nil, nil, nil, @SubKeyCnt, @MaxSubKeyLen, nil,
      nil, nil, nil, nil, nil) = ERROR_SUCCESS) then
      Exit;
    if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
      Inc(MaxSubKeyLen, MaxSubKeyLen);
    Strings.Clear;
    SetString(SubKeyName, nil, MaxSubKeyLen + 1);
    for i := 0 to SubKeyCnt - 1 do
    begin
      Len := MaxSubKeyLen + 1;
      if RegEnumKeyEx(hK, i, PChar(SubKeyName), Len, nil, nil, nil, nil) = ERROR_SUCCESS
      then
        Strings.Add(PChar(SubKeyName))
      else
      begin
        Result := False;
        Break;
      end;
    end;
    Result := True;
  finally
    if hK <> 0 then
      RegCloseKey(hK);
  end;
end;

function RegGetValueNames(KeyName: string; Strings: TStrings;
  RootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
var
  ValueCnt: DWORD;
  MaxValueNameLen, Len: DWORD;
  hK: HKEY;
  i: Integer;
  ValueName: string;
begin
  Result := False;
  hK := 0;
  try
    if not RegGetKey(RootKey, KeyName, hK) or
      not(RegQueryInfoKey(hK, nil, nil, nil, nil, nil, nil, @ValueCnt,
      @MaxValueNameLen, nil, nil, nil) = ERROR_SUCCESS) then
      Exit;
    if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
      Inc(MaxValueNameLen, MaxValueNameLen);
    Strings.Clear;
    SetString(ValueName, nil, MaxValueNameLen + 1);
    for i := 0 to ValueCnt do
    begin
      Len := MaxValueNameLen + 1;
      if RegEnumKeyEx(hK, i, PChar(ValueName), Len, nil, nil, nil, nil) = ERROR_SUCCESS
      then
        Strings.Add(PChar(ValueName))
      else
      begin
        Result := False;
        Break;
      end;
    end;
    Result := True;
  finally
    if hK <> 0 then
      RegCloseKey(hK);
  end;
end;

end.
